home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / ptg120co.zip / BBDLG.PAS next >
Pascal/Delphi Source File  |  1993-11-06  |  20KB  |  174 lines

  1. (* This file was mangled by Mangler 1.13 (c) Copyright 1993 by Berend de Boer *)
  2.  {$IFDEF DPMI} {$X+,S-,I-,V-} {$ELSE} {$X+,O+,F+,I-,R-,Q-,S-,V-,D-} {$ENDIF} UNIT BBDLG ;INTERFACE USES OBJECTS ,
  3. DRIVERS , MENUS , VIEWS , DIALOGS ;CONST MFWARNING =$0000 ;MFERROR =$0001 ;MFINFORMATION =$0002 ;MFCONFIRMATION =$0003 ;
  4. MFYESBUTTON =$0100 ;MFNOBUTTON =$0200 ;MFOKBUTTON =$0400 ;MFCANCELBUTTON =$0800 ;MFHELPBUTTON =$1000 ;
  5. MFYESNOCANCEL =MFYESBUTTON + MFNOBUTTON + MFCANCELBUTTON ;MFOKCANCEL =MFOKBUTTON + MFCANCELBUTTON ;
  6. MFOKCANCELHELP =MFOKBUTTON + MFCANCELBUTTON + MFHELPBUTTON ;CONST PASSWORDLEN =8 ;CONST NUMBERS ='0123456789';
  7. CAPITALS ='ABCDEFGHIJKLMNOPQRSTUVWXYZ';LOWERCASE ='abcdefghijklmnopqrstuvwxyz';ALLCHARS ='';CONST CMEDITITEM =240 ;
  8. CMBEDITITEM =CMEDITITEM ;CMDELETEITEM =241 ;CMINSERTITEM =242 ;CMBDELETEITEM =243 ;CMBINSERTITEM =244 ;CONST ENGLISH =0 ;
  9. DUTCH =0 ;CONST YES =CMYES ;NO =CMNO ;CANCEL =CMCANCEL ;TYPE PPOPUPMENU =^TPOPUPMENU ;
  10. TPOPUPMENU =OBJECT (TMENUPOPUP)DESTRUCTOR DONE ;VIRTUAL;END ;PSPINBUTTON =^TSPINBUTTON ;
  11. TSPINBUTTON =OBJECT (TRADIOBUTTONS)CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;ASTRINGS :PSITEM );PROCEDURE DRAW ;VIRTUAL;END ;
  12. PXINPUTLINE =^TXINPUTLINE ;TXINPUTLINE =OBJECT (TINPUTLINE)PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;END ;
  13. PLISTVIEWER2 =^TLISTVIEWER2 ;TLISTVIEWER2 =OBJECT (TLISTVIEWER)CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;ANUMCOLS :INTEGER ;
  14. AHSCROLLBAR ,AVSCROLLBAR:PSCROLLBAR );PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;PROCEDURE INSERTITEM ;VIRTUAL;
  15. PROCEDURE DELETEITEM ;VIRTUAL;PROCEDURE EDITITEM ;VIRTUAL;END ;TLISTBOXREC =RECORD LIST :PCOLLECTION ;SELECTION :WORD ;
  16. END ;PLISTBOX2 =^TLISTBOX2 ;TLISTBOX2 =OBJECT (TLISTBOX)CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;ANUMCOLS :INTEGER ;
  17. AVSCROLLBAR :PSCROLLBAR );PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;PROCEDURE INSERTITEM ;VIRTUAL;
  18. PROCEDURE DELETEITEM ;VIRTUAL;PROCEDURE EDITITEM ;VIRTUAL;END ;PPARAMINPUTBOX =^TPARAMINPUTBOX ;
  19. TPARAMINPUTBOX =OBJECT (TLISTBOX2)PROCEDURE INSERTITEM ;VIRTUAL;PROCEDURE DELETEITEM ;VIRTUAL;PROCEDURE EDITITEM ;
  20. VIRTUAL;END ;PSTRINGINPUTBOX =^TSTRINGINPUTBOX ;TSTRINGINPUTBOX =OBJECT (TLISTBOX2)PROCEDURE INSERTITEM ;VIRTUAL;
  21. PROCEDURE DELETEITEM ;VIRTUAL;PROCEDURE EDITITEM ;VIRTUAL;END ;PROCEDURE DISPOSESITEM (PS :PSITEM );PROCEDURE PRINTERROR
  22. (CONST S :STRING ;AHELPCTX :WORD );FUNCTION PROMPTUSER (CONST S :STRING ;AHELPCTX :WORD ):WORD ;FUNCTION USERANSWER
  23. (CONST S :STRING ;AHELPCTX :WORD ):WORD ;FUNCTION POPANSWER (CONST S :STRING ;AHELPCTX :WORD ):WORD ;
  24. FUNCTION INPUTSTRING (HEADER :STRING ;VAR S :STRING ;LEN :WORD ;ALLOWEDCHARS :STRING ;AHELPCTX :WORD ):WORD ;
  25. FUNCTION INPUTWORD (HEADER :STRING ;VAR W :WORD ;LEN :WORD ;AHELPCTX :WORD ):WORD ;PROCEDURE INFOBOX (S :STRING ;
  26. AHELPCTX :WORD );FUNCTION EXECDIALOG (P :PDIALOG ;DATA :POINTER ):WORD ;FUNCTION CHECKEXECDIALOG (P :PDIALOG ;
  27. DATA :POINTER ;DATASIZE :WORD ):WORD ;FUNCTION PASSWORD (CONST S :STRING ;AHELPCTX :WORD ):BOOLEAN ;
  28. PROCEDURE INSERTBUTTONS (DIALOG :PDIALOG ;AOPTIONS :WORD );PROCEDURE CREATESTATUSDLG (CONST ATITLE :TTITLESTR ;
  29. ATOTAL :LONGINT ;AHELPCTX :WORD );PROCEDURE DISPOSESTATUSDLG ;PROCEDURE STATUSDLGSET (POSITION :LONGINT );
  30. PROCEDURE STATUSDLGNEWTEXT (CONST S :STRING );FUNCTION MESSAGEBOX (CONST MSG :STRING ;PARAMS :POINTER ;AOPTIONS :WORD ;
  31. AHELPCTX :WORD ):WORD ;FUNCTION MESSAGEBOXRECT (VAR R :TRECT ;CONST MSG :STRING ;PARAMS :POINTER ;AOPTIONS :WORD ;
  32. AHELPCTX :WORD ):WORD ;IMPLEMENTATION USES APP , BBGUI , BBUTIL , BBFILE , BBERROR , BBSTRRES ;{$I PREAPP.INC}
  33. CONST OOIOlO01OOI0=1000 ;OOIOO1OlO0Il=1001 ;TYPE OI1O11O0II1=^OI1O11O0IO0;
  34. OI1O11O0IO0=OBJECT (TXINPUTLINE)O10OlIOO01O10:STRING ;CONSTRUCTOR INIT (VAR O10O0OO1lIOO0:TRECT;OOII00O01010:INTEGER;
  35. O10OlIIIO0ll1:STRING );PROCEDURE HANDLEEVENT (VAR EVENT:TEVENT);VIRTUAL;END ;O1010llIO1I10=^O1010llIO1I01;
  36. O1010llIO1I01=OBJECT (TINPUTLINE)PROCEDURE DRAW ;VIRTUAL;END ;OI10O0OI011=^OI10O0OI00I;
  37. OI10O0OI00I=OBJECT (TVIEW)CONSTRUCTOR INIT (O10O0OO1lIOO0:TRECT);PROCEDURE DRAW ;VIRTUAL;FUNCTION GETPALETTE :PPALETTE ;
  38. VIRTUAL;PROCEDURE UPDATE (OOIIOlIl00lO:WORD);FUNCTION VALID (OlIlOOOl0:WORD):BOOLEAN ;VIRTUAL;PRIVATE
  39. O100lll0I1l:INTEGER;END ;OOO001lOO1OI=^OOO001lOO1IO;OOO001lOO1IO=OBJECT (TDIALOG)O100lll0I1l:INTEGER;
  40. OI1I01OI0Ol:LONGINT;Ol010II0OOI0:PSTATICTEXT;OlI01Ol1I:OI10O0OI011;OOllI0II0lIO:PSTATICTEXT;CONSTRUCTOR INIT
  41. (VAR O10O0OO1lIOO0:TRECT;OI110IO10Oll:TTITLESTR;OI11Oll000I:LONGINT);PROCEDURE SETPERC (O101OIl1l00IO:LONGINT);
  42. PROCEDURE NEWTEXT (CONST OO1O:STRING );END ;CONST OOO000O0II0O:OOO001lOO1OI=NIL ;PROCEDURE DISPOSESITEM (PS:PSITEM);
  43. BEGIN IF PS <> NIL THEN BEGIN DISPOSESITEM (PS ^. NEXT );DISPOSESTR (PS ^. VALUE );DISPOSE (PS );END ;END ;
  44. FUNCTION MESSAGEBOX (CONST MSG:STRING ;PARAMS:POINTER;AOPTIONS:WORD;AHELPCTX:WORD):WORD ;VAR OO1I:TRECT;
  45. BEGIN OO1I.ASSIGN (0 , 0 , 40 , 9 );OO1I.MOVE ((DESKTOP ^. SIZE.X - OO1I.B.X )DIV 2 , (DESKTOP ^. SIZE.Y - OO1I.B.Y )DIV
  46. 2 );MESSAGEBOX := MESSAGEBOXRECT (OO1I , MSG , PARAMS , AOPTIONS , AHELPCTX );END ;PROCEDURE INSERTBUTTONS
  47. (DIALOG:PDIALOG;AOPTIONS:WORD);CONST O100l11l1IO01:ARRAY [ 0 .. 4 ]  OF STRING [ 6 ] =('~Y~es', '~N~o', 'O~K~', 'Cancel',
  48. 'Help');CONST OOIIIlI0Il1O:ARRAY [ 0 .. 4 ]  OF WORD=(CMYES, CMNO, CMOK, CMCANCEL, CMHELP);
  49. VAR OIlO,OOIO,O10OO0Il0OIl0:INTEGER;OO1000011:PVIEW;OO1I:TRECT;OOO0OlOI0lIl:ARRAY [ 0 .. 4 ]  OF PVIEW;
  50. BEGIN WITH DIALOG^ DO BEGIN OOIO := - 2 ;O10OO0Il0OIl0 := 0 ;FOR OIlO := 0 TO 4  DO IF AOPTIONS AND ($0100 SHL OIlO )<> 0
  51. THEN BEGIN OO1I.ASSIGN (0 , 0 , 10 , 2 );IF OIlO =2 THEN BEGIN IF STRINGS =NIL THEN OO1000011 := NEW (PBUTTON , INIT
  52. (OO1I , O100l11l1IO01 [ OIlO ] , OOIIIlI0Il1O [ OIlO ] , BFDEFAULT ))ELSE OO1000011 := NEW (PBUTTON , INIT (OO1I , RSGET
  53. (SBUTTONYES + OIlO ), OOIIIlI0Il1O [ OIlO ] , BFDEFAULT ));END ELSE BEGIN IF STRINGS =NIL THEN OO1000011 := NEW (PBUTTON
  54. , INIT (OO1I , O100l11l1IO01 [ OIlO ] , OOIIIlI0Il1O [ OIlO ] , BFNORMAL ))ELSE OO1000011 := NEW (PBUTTON , INIT (OO1I ,
  55. RSGET (SBUTTONYES + OIlO ), OOIIIlI0Il1O [ OIlO ] , BFNORMAL ));END ;INC (OOIO , OO1000011 ^. SIZE.X + 2 );OOO0OlOI0lIl [
  56. O10OO0Il0OIl0 ] := OO1000011 ;INC (O10OO0Il0OIl0 );END ;OOIO := (SIZE.X - OOIO )SHR 1 ;FOR OIlO := 0 TO O10OO0Il0OIl0 - 1
  57.  DO BEGIN OO1000011 := OOO0OlOI0lIl [ OIlO ] ;INSERT (OO1000011 );OO1000011 ^. MOVETO (OOIO , SIZE.Y - 3 );INC (OOIO ,
  58. OO1000011 ^. SIZE.X + 2 );END ;SELECTNEXT (FALSE );END ;END ;FUNCTION MESSAGEBOXRECT (VAR R:TRECT;CONST MSG:STRING ;
  59. PARAMS:POINTER;AOPTIONS:WORD;AHELPCTX:WORD):WORD ;CONST O10O0lIO1000I:ARRAY [ 0 .. 3 ]  OF STRING [ 11 ] =('Warning',
  60. 'Error', 'Information', 'Confirm');VAR O10OIIIOll1O1:PDIALOG;OO1000011:PVIEW;OO1O:STRING ;BEGIN IF STRINGS =NIL THEN
  61. O10OIIIOll1O1 := NEW (PDIALOG , INIT (R , O10O0lIO1000I [ AOPTIONS AND $3 ] ))ELSE O10OIIIOll1O1 := NEW (PDIALOG , INIT
  62. (R , RSGET (SWARNING + (AOPTIONS AND $3 ))));WITH O10OIIIOll1O1^ DO BEGIN R.ASSIGN (3 , 2 , SIZE.X - 2 , SIZE.Y - 3 );
  63. FORMATSTR (OO1O , MSG , PARAMS ^);OO1000011 := NEW (PSTATICTEXT , INIT (R , OO1O ));INSERT (OO1000011 );INSERTBUTTONS
  64. (O10OIIIOll1O1 , AOPTIONS );END ;O10OIIIOll1O1 ^. HELPCTX := AHELPCTX ;MESSAGEBOXRECT := DESKTOP ^. EXECVIEW
  65. (O10OIIIOll1O1 );DISPOSE (O10OIIIOll1O1 , DONE );END ;PROCEDURE PRINTERROR (CONST S:STRING ;AHELPCTX:WORD);BEGIN IF
  66. APPLICATION =NIL THEN BBGUI.TEXTPRINTERROR (S , AHELPCTX )ELSE BEGIN BEEP ;MESSAGEBOX (S , NIL , MFERROR + MFOKBUTTON ,
  67. AHELPCTX );LOGERROR ('Error: '+ S );DUMPSTACK (0 );END ;END ;FUNCTION PROMPTUSER (CONST S:STRING ;AHELPCTX:WORD):WORD ;
  68. BEGIN IF APPLICATION =NIL THEN BEGIN WRITELN (S );PROMPTUSER := CMYES ;END ELSE PROMPTUSER := MESSAGEBOX (S , NIL ,
  69. MFINFORMATION + MFOKBUTTON , AHELPCTX );END ;FUNCTION USERANSWER (CONST S:STRING ;AHELPCTX:WORD):WORD ;BEGIN IF
  70. APPLICATION =NIL THEN USERANSWER := TEXTUSERANSWER (S , AHELPCTX )ELSE USERANSWER := MESSAGEBOX (S , NIL , MFCONFIRMATION
  71. + MFYESNOCANCEL , AHELPCTX );END ;FUNCTION POPANSWER (CONST S:STRING ;AHELPCTX:WORD):WORD ;BEGIN POPANSWER := USERANSWER
  72. (S , AHELPCTX );END ;CONSTRUCTOR OI1O11O0IO0.INIT (VAR O10O0OO1lIOO0:TRECT;OOII00O01010:INTEGER;O10OlIIIO0ll1:STRING );
  73. BEGIN INHERITED INIT(O10O0OO1lIOO0 , OOII00O01010 );